home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / TURB_VIS / PGC122 / BBFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1994-02-09  |  14KB  |  125 lines
  1. (* This file was mangled by Mangler 1.14 (c) Copyright 1993 by Berend de Boer *)
  2.  {$IFDEF DPMI} {$S-,I-} {$ELSE} {$F+,O+,R-,Q-,S-,V-,I-} {$ENDIF} UNIT BBFILE ;INTERFACE USES OBJECTS , DOS ;
  3. CONST FMREADONLY =$00 ;FMWRITEONLY =$01 ;FMREADWRITE =$02 ;FMDENYALL =$10 ;FMDENYWRITE =$20 ;FMDENYREAD =$30 ;
  4. FMDENYNONE =$40 ;FMNOWAIT =$100 ;CONST STCREATE =$3C00 ;STOPEN =$3D00 ;TYPE DRIVETYPE =STRING [ 2 ] ;PROCEDURE DOSDEL
  5. (CONST PATH :PATHSTR );PROCEDURE DOSCOPY (SOURCE ,DESTINATION:PATHSTR ;AHELPCTX :WORD );PROCEDURE DOSMOVE
  6. (CONST SOURCE ,DEST:PATHSTR ;AHELPCTX :WORD );PROCEDURE DOSWIPE (CONST PATH :PATHSTR );PROCEDURE DOSTOUCH
  7. (CONST PATH :PATHSTR );CONST IOERRNUM :INTEGER =0 ;PROCEDURE CREATEBAK (CONST FILENAME :PATHSTR ;HELPCTX :WORD );
  8. FUNCTION FCREATE (VAR F :FILE ;AFILEMODE :WORD ):INTEGER ;FUNCTION FDEFAULTEXTENSION (CONST FILENAME :PATHSTR ;
  9. CONST EXT :EXTSTR ):STRING ;FUNCTION FFORCEEXTENSION (CONST FILENAME :PATHSTR ;CONST EXT :EXTSTR ):STRING ;
  10. FUNCTION FFORCEDIR (CONST FILENAME :PATHSTR ;DIR :DIRSTR ):STRING ;FUNCTION FILEEXIST
  11. (CONST FILENAME :PATHSTR ):BOOLEAN ;FUNCTION FILEOPEN (VAR F ):BOOLEAN ;FUNCTION FOPEN (VAR F :FILE ;
  12. AFILEMODE :WORD ):INTEGER ;FUNCTION GETDRIVE :DRIVETYPE ;FUNCTION GETFILENAME (VAR F :FILE ):STRING ;
  13. FUNCTION GETTEXTFILENAME (VAR T :TEXT ):STRING ;FUNCTION GETUNIQUEFILENAME :STRING ;FUNCTION IOERROR (CONST S :STRING ;
  14. AHELPCTX :WORD ):BOOLEAN ;FUNCTION MATCHFILENAMES (CONST SOURCE ,DEST:PATHSTR ):STRING ;PROCEDURE SETHANDLECOUNT
  15. (HANDLES :WORD );PROCEDURE SETHANDLECOUNTDOS3 (HANDLES :WORD );FUNCTION XPARAMSTR (INDEX :WORD ):STRING ;
  16. IMPLEMENTATION USES BBUTIL , {$IFDEF DPMI} WINAPI , {$ENDIF} BBERROR , BBSTRRES , BBGUI ;{$I PREAPP.INC} PROCEDURE DOSDEL
  17. (CONST PATH:PATHSTR);VAR OIl0:FILE ;O101IO1IOlIl1:SEARCHREC;OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (PATH ,
  18. OIOO , OO0O , OIOl );FINDFIRST (PATH , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN ASSIGN (OIl0 , OIOO +
  19. O101IO1IOlIl1.NAME );ERASE (OIl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;PROCEDURE DOSCOPY (SOURCE,DESTINATION:PATHSTR;
  20. AHELPCTX:WORD);VAR O101IO1IOlIl1:SEARCHREC;O1lO01OlI1lO:WORD;OOlIll0O0lll:POINTER;O1lIIlO1I0lI,OOO0OOI1ll10:DIRSTR;
  21. OII010l00O,O1lO0I00IOlO:NAMESTR;O1010O1I0I10O,OI1OO1IIOl:EXTSTR;OIl10I10l,OI110IOOO0l0:PDOSSTREAM;PROCEDURE O1lIOlO0O1l1
  22. ;VAR OIOOlO1I0l1:BOOLEAN;O1OOlI1IIIOO:BYTE;PROCEDURE O101IlO10I10I (VAR OIOOlO1I0l1:BOOLEAN);BEGIN BEEP ;IF
  23. BBSTRRES.STRINGS =NIL THEN OIOOlO1I0l1 := USERANSWER ('Disk is full. Insert new disk in '+ 'drive '+ CHR (O1OOlI1IIIOO +
  24. ORD ('A')- 1 ), 0 )=CMYES ELSE OIOOlO1I0l1 := USERANSWER (RSGET1 (SINFORMUSER , O1OOlI1IIIOO + ORD ('A')- 1 ), AHELPCTX
  25. )=CMYES ;END ;BEGIN SOURCE := FEXPAND (SOURCE );DESTINATION := FEXPAND (DESTINATION );O1OOlI1IIIOO := ORD (DESTINATION [
  26. 1 ] )- ORD ('A')+ 1 ;FSPLIT (SOURCE , O1lIIlO1I0lI , OII010l00O , O1010O1I0I10O );FSPLIT (DESTINATION , OOO0OOI1ll10 ,
  27. O1lO0I00IOlO , OI1OO1IIOl );FINDFIRST (SOURCE , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN IF DISKFREE
  28. (O1OOlI1IIIOO )< O101IO1IOlIl1.SIZE THEN BEGIN O101IlO10I10I (OIOOlO1I0l1 );IF OIOOlO1I0l1 THEN EXIT ;END ;OIl10I10l :=
  29. NEW (PBUFSTREAM , INIT (O1lIIlO1I0lI + O101IO1IOlIl1.NAME , STOPEN + FMREADONLY + FMDENYWRITE , 8192 ));OI110IOOO0l0 :=
  30. NEW (PBUFSTREAM , INIT (OOO0OOI1ll10 + MATCHFILENAMES (O101IO1IOlIl1.NAME , O1lO0I00IOlO + OI1OO1IIOl ), STCREATE +
  31. FMWRITEONLY + FMDENYALL , 8192 ));OI110IOOO0l0 ^. COPYFROM (OIl10I10l ^, OIl10I10l ^. GETSIZE );ASM {}
  32. LES DI , OI110IOOO0l0{} MOV BX , ES : [ DI ] . TDOSSTREAM.HANDLE{} MOV CX , WORD PTR O101IO1IOlIl1.TIME{}
  33. MOV DX , WORD PTR O101IO1IOlIl1.TIME+ 2 {} MOV AX , 5701h {} INT 21h {} END;DISPOSE (OI110IOOO0l0 , DONE );DISPOSE
  34. (OIl10I10l , DONE );FINDNEXT (O101IO1IOlIl1 );END ;END ;BEGIN IF MAXAVAIL < 3 * 8192 THEN BEGIN IF BBSTRRES.STRINGS =NIL
  35. THEN PRINTERROR ('Not enough memory to copy files.', AHELPCTX )ELSE PRINTERROR (RSGET (SNOTENOUGHMEMORY ), AHELPCTX );
  36. DOSERROR := 8 ;END ELSE O1lIOlO0O1l1 ;END ;PROCEDURE DOSMOVE (CONST SOURCE,DEST:PATHSTR;AHELPCTX:WORD);
  37. VAR OI0lOOI1ll1O,O1OO1IIl010I:DRIVETYPE;O101IO1IOlIl1:SEARCHREC;O1lIIlO1I0lI,OOO0OOI1ll10:DIRSTR;
  38. OII010l00O,O1lO0I00IOlO:NAMESTR;O1010O1I0I10O,OI1OO1IIOl:EXTSTR;OIl0:FILE ;OI111IlIOOl0:PATHSTR;BEGIN IF SOURCE =DEST
  39. THEN EXIT ;IF SOURCE [ 2 ] =':'THEN OI0lOOI1ll1O := COPY (SOURCE , 1 , 2 )ELSE OI0lOOI1ll1O := GETDRIVE ;IF DEST [ 2 ]
  40. =':'THEN O1OO1IIl010I := COPY (DEST , 1 , 2 )ELSE O1OO1IIl010I := GETDRIVE ;IF OI0lOOI1ll1O <> O1OO1IIl010I THEN
  41. BEGIN DOSCOPY (SOURCE , DEST , AHELPCTX );DOSDEL (SOURCE );END ELSE BEGIN FSPLIT (SOURCE , O1lIIlO1I0lI , OII010l00O ,
  42. O1010O1I0I10O );FSPLIT (DEST , OOO0OOI1ll10 , O1lO0I00IOlO , OI1OO1IIOl );FINDFIRST (SOURCE , ARCHIVE , O101IO1IOlIl1 );
  43. WHILE DOSERROR =0  DO BEGIN OI111IlIOOl0 := MATCHFILENAMES (O101IO1IOlIl1.NAME , DEST );ASSIGN (OIl0 , O1lIIlO1I0lI +
  44. O101IO1IOlIl1.NAME );DOSDEL (OI111IlIOOl0 );RENAME (OIl0 , OI111IlIOOl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;END ;
  45. PROCEDURE DOSWIPE (CONST PATH:PATHSTR);VAR OIl0:FILE ;O101IO1IOlIl1:SEARCHREC;PROCEDURE OlOII10100 (VAR OIl0:FILE );
  46. CONST O1lI00Oll1lO:BYTE=0 ;OI1II1OIOIOl:BYTE=$FF ;OI1IIO00I1ll:BYTE=$F6 ;VAR OIO11IOOlO0:WORD;OIlO:LONGINT;OIll:WORD;
  47. BEGIN RESET (OIl0 , 1 );FOR OIll := 1 TO 3  DO BEGIN SEEK (OIl0 , 0 );FOR OIlO := 0 TO FILESIZE (OIl0 )- 1  DO BLOCKWRITE
  48. (OIl0 , OI1II1OIOIOl , 1 , OIO11IOOlO0 );SEEK (OIl0 , 0 );FOR OIlO := 0 TO FILESIZE (OIl0 )- 1  DO BLOCKWRITE (OIl0 ,
  49. O1lI00Oll1lO , 1 , OIO11IOOlO0 );END ;SEEK (OIl0 , 0 );FOR OIlO := 0 TO FILESIZE (OIl0 )- 1  DO BLOCKWRITE (OIl0 ,
  50. OI1IIO00I1ll , 1 , OIO11IOOlO0 );CLOSE (OIl0 );END ;PROCEDURE OOlI1IlI0O0O ;BEGIN RESET (OIl0 );TRUNCATE (OIl0 );CLOSE
  51. (OIl0 );RENAME (OIl0 , 'TMP00000.$$$');END ;VAR OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (PATH , OIOO , OO0O ,
  52. OIOl );FINDFIRST (PATH , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN ASSIGN (OIl0 , OIOO + O101IO1IOlIl1.NAME
  53. );OlOII10100 (OIl0 );OOlI1IlI0O0O ;ERASE (OIl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;PROCEDURE DOSTOUCH
  54. (CONST PATH:PATHSTR);VAR O101IO1IOlIl1:SEARCHREC;OIl0:FILE ;OI111O0100ll:LONGINT;OO1l:DATETIME;
  55. OOIl,OIO0OI11l1l,O101OO1O,OIlO11001ll:WORD;OIlI,OO0I,OO1O,O10lO0O0:WORD;OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;
  56. BEGIN FSPLIT (PATH , OIOO , OO0O , OIOl );FINDFIRST (PATH , ARCHIVE , O101IO1IOlIl1 );WHILE DOSERROR =0  DO BEGIN ASSIGN
  57. (OIl0 , OIOO + O101IO1IOlIl1.NAME );RESET (OIl0 , 1 );GETFTIME (OIl0 , OI111O0100ll );UNPACKTIME (OI111O0100ll , OO1l );
  58. GETDATE (OOIl , OIO0OI11l1l , O101OO1O , OIlO11001ll );GETTIME (OIlI , OO0I , OO1O , O10lO0O0 );WITH OO1l DO BEGIN YEAR
  59. := OOIl ;MONTH := OIO0OI11l1l ;DAY := O101OO1O ;HOUR := OIlI ;MIN := OO0I ;SEC := OO1O ;END ;PACKTIME (OO1l ,
  60. OI111O0100ll );SETFTIME (OIl0 , OI111O0100ll );CLOSE (OIl0 );FINDNEXT (O101IO1IOlIl1 );END ;END ;PROCEDURE CREATEBAK
  61. (CONST FILENAME:PATHSTR;HELPCTX:WORD);BEGIN IF FILEEXIST (FILENAME )THEN DOSMOVE (FILENAME , FFORCEEXTENSION (FILENAME ,
  62. '.BAK'), HELPCTX );END ;FUNCTION FCREATE (VAR F:FILE ;AFILEMODE:WORD):INTEGER ;VAR OIO11IOOlO0:WORD;BEGIN IF AFILEMODE
  63. AND FMWRITEONLY <> 0 THEN BEGIN AFILEMODE := AFILEMODE AND NOT FMWRITEONLY ;AFILEMODE := AFILEMODE OR FMREADWRITE ;END ;
  64. REPEAT REWRITE (F , 1 );OIO11IOOlO0 := IORESULT ;IF OIO11IOOlO0 =0 THEN BEGIN CLOSE (F );OIO11IOOlO0 := FOPEN (F ,
  65. AFILEMODE );END ;UNTIL (AFILEMODE AND FMNOWAIT =0 )OR (OIO11IOOlO0 =0 );FCREATE := OIO11IOOlO0 ;END ;
  66. FUNCTION FDEFAULTEXTENSION (CONST FILENAME:PATHSTR;CONST EXT:EXTSTR):STRING ;BEGIN IF POS ('.', FILENAME )=0 THEN
  67. FDEFAULTEXTENSION := FILENAME + EXT ELSE FDEFAULTEXTENSION := FILENAME ;END ;FUNCTION FFORCEEXTENSION
  68. (CONST FILENAME:PATHSTR;CONST EXT:EXTSTR):STRING ;VAR OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (FILENAME , OIOO
  69. , OO0O , OIOl );FFORCEEXTENSION := OIOO + OO0O + EXT ;END ;FUNCTION FFORCEDIR (CONST FILENAME:PATHSTR;DIR:DIRSTR):STRING
  70. ;VAR OIOO:DIRSTR;OO0O:NAMESTR;OIOl:EXTSTR;BEGIN FSPLIT (FILENAME , OIOO , OO0O , OIOl );IF DIR [ LENGTH (DIR )] <>
  71. '\'THEN DIR := DIR + '\';FFORCEDIR := DIR + OO0O + OIOl ;END ;FUNCTION FILEEXIST (CONST FILENAME:PATHSTR):BOOLEAN ;
  72. VAR OIl0:FILE ;Ol00IO0IOlO0:WORD;BEGIN ASSIGN (OIl0 , FILENAME );GETFATTR (OIl0 , Ol00IO0IOlO0 );FILEEXIST := DOSERROR =0
  73. ;END ;FUNCTION FILEOPEN (VAR F):BOOLEAN ;BEGIN FILEOPEN := (FILEREC (F ). MODE =FMINOUT )OR (FILEREC (F ). MODE =FMOUTPUT
  74. )OR (FILEREC (F ). MODE =FMINPUT );END ;FUNCTION FOPEN (VAR F:FILE ;AFILEMODE:WORD):INTEGER ;VAR O111O11I:BYTE;
  75. OIOO:WORD;BEGIN O111O11I := FILEMODE ;FILEMODE := AFILEMODE ;RESET (F , 1 );WHILE (AFILEMODE AND FMNOWAIT =0 )AND
  76. (INOUTRES <> 0 ) DO BEGIN CASE INOUTRES  OF 33 , 32 , 5 , 162 :DELAY (100 );ELSE BEGIN IF FILEOPEN (FERR )THEN WRITELN
  77. (FERR , 'FOpen IOError = ', INOUTRES );BREAK ;END ;END ;OIOO := IORESULT ;RESET (F , 1 );END ;FOPEN := IORESULT ;;
  78. FILEMODE := O111O11I ;END ;FUNCTION GETDRIVE :DRIVETYPE ;VAR O10O11I0I01O0:REGISTERS;OO1O:DRIVETYPE;
  79. BEGIN O10O11I0I01O0.AX := $1900 ;MSDOS (O10O11I0I01O0 );GETDRIVE := CHR (65 + O10O11I0I01O0.AL )+ ':';END ;
  80. FUNCTION GETFILENAME (VAR F:FILE ):STRING ;BEGIN GETFILENAME := COPY (FILEREC (F ). NAME , 1 , POS (#0, FILEREC (F ).
  81. NAME )- 1 );END ;FUNCTION GETTEXTFILENAME (VAR T:TEXT):STRING ;BEGIN GETTEXTFILENAME := COPY (TEXTREC (T ). NAME , 1 ,
  82. POS (#0, TEXTREC (T ). NAME )- 1 );END ;FUNCTION GETUNIQUEFILENAME :STRING ;VAR OO1O:FNAMESTR;OIlO:INTEGER;
  83. BEGIN FILLCHAR (OO1O , SIZEOF (OO1O ), 0 );GETDIR (0 , OO1O );OO1O [ LENGTH (OO1O )+ 1 ] := '\';ASM {} PUSH DS {}
  84. MOV CL , SYSTEM.FILEMODE{} XOR CH , CH {} MOV AX , SS {} MOV DS , AX {} LEA DX , OO1O[ 1 ] {} MOV AH , 05ah {}
  85. INT 021h {} MOV BX , AX {} MOV AH , 03eh {} INT 021h {} MOV AH , 041h {} INT 021h {} POP DS {} END;OIlO := LENGTH (OO1O
  86. )+ 2 ;WHILE OO1O [ OIlO ] <> #0 DO INC (OIlO );OO1O [ 0 ] := CHR (OIlO - 1 );GETUNIQUEFILENAME := OO1O ;END ;
  87. FUNCTION IOERROR (CONST S:STRING ;AHELPCTX:WORD):BOOLEAN ;BEGIN IOERRNUM := IORESULT ;IF IOERRNUM <> 0 THEN BEGIN IOERROR
  88. := TRUE ;IF STRINGS =NIL THEN BEGIN CASE IOERRNUM  OF 2 , 3 :PRINTERROR ('File '+ S + ' not found.', AHELPCTX );4
  89. :PRINTERROR ('Too many open files.', AHELPCTX );5 :PRINTERROR ('File '+ S + ' is read-only.', AHELPCTX );100 :PRINTERROR
  90. ('Disk read error.', AHELPCTX );101 :PRINTERROR ('Disk write error or disk full.', AHELPCTX );103 :PRINTERROR
  91. ('File not open or disk not formatted.', AHELPCTX );150 :PRINTERROR ('Disk is write-protected.', AHELPCTX );152
  92. :PRINTERROR ('Drive not ready.', AHELPCTX );159 :PRINTERROR ('Printer out of paper', AHELPCTX );162 :PRINTERROR
  93. ('Hardware failure.', AHELPCTX );ELSE PRINTERROR ('Internal error. '+ S , AHELPCTX );END ;END ELSE BEGIN CASE IOERRNUM
  94.  OF 2 , 3 :PRINTERROR (RSGET2 (SFILENOTFOUND , IOERRNUM , LONGINT (@ S )), AHELPCTX );4 :PRINTERROR (RSGET
  95. (STOOMANYOPENFILES ), AHELPCTX );5 :PRINTERROR (RSGET2 (SFILEREADONLY , IOERRNUM , LONGINT (@ S )), AHELPCTX );100
  96. :PRINTERROR (RSGET (SDISKREADERROR ), AHELPCTX );101 :PRINTERROR (RSGET (SDISKFULL ), AHELPCTX );103 :PRINTERROR (RSGET2
  97. (SFILENOTOPEN , IOERRNUM , LONGINT (@ S )), AHELPCTX );150 :PRINTERROR (RSGET (SDISKWRITEPROTECTED ), AHELPCTX );152
  98. :PRINTERROR (RSGET (SDRIVENOTREADY ), AHELPCTX );159 :PRINTERROR (RSGET (SOUTOFPAPER ), AHELPCTX );162 :PRINTERROR (RSGET
  99. (SHARDWAREFAILURE ), AHELPCTX );ELSE PRINTERROR (RSGET1 (SINTERNALERROR , IOERRNUM ), AHELPCTX );END ;END ;END ELSE
  100. IOERROR := FALSE ;END ;FUNCTION MATCHFILENAMES (CONST SOURCE,DEST:PATHSTR):STRING ;VAR OO10:WORD;OIlO:INTEGER;
  101. O1lIIlO1I0lI,OOO0OOI1ll10:DIRSTR;OII010l00O,O1lO0I00IOlO:NAMESTR;O1010O1I0I10O,OI1OO1IIOl:EXTSTR;BEGIN FSPLIT (SOURCE ,
  102. O1lIIlO1I0lI , OII010l00O , O1010O1I0I10O );FSPLIT (DEST , OOO0OOI1ll10 , O1lO0I00IOlO , OI1OO1IIOl );IF O1lO0I00IOlO
  103. =''THEN O1lO0I00IOlO := OII010l00O ELSE BEGIN OO10 := CPOS ('*', O1lO0I00IOlO );IF OO10 > 0 THEN BEGIN DELETE
  104. (O1lO0I00IOlO , OO10 , LENGTH (O1lO0I00IOlO ));O1lO0I00IOlO := O1lO0I00IOlO + COPY (OII010l00O , OO10 , LENGTH
  105. (OII010l00O ));END ELSE BEGIN OO10 := CPOS ('?', O1lO0I00IOlO );IF OO10 > 0 THEN BEGIN FOR OIlO := OO10 TO LENGTH
  106. (O1lO0I00IOlO ) DO IF (O1lO0I00IOlO [ OIlO ] ='?')AND (OIlO <= LENGTH (OII010l00O ))THEN O1lO0I00IOlO [ OIlO ] :=
  107. OII010l00O [ OIlO ] END ;END ;END ;IF OI1OO1IIOl =''THEN OI1OO1IIOl := O1010O1I0I10O ELSE BEGIN OO10 := CPOS ('*',
  108. OI1OO1IIOl );IF OO10 > 0 THEN BEGIN DELETE (OI1OO1IIOl , OO10 , LENGTH (OI1OO1IIOl ));OI1OO1IIOl := OI1OO1IIOl + COPY
  109. (O1010O1I0I10O , OO10 , LENGTH (O1010O1I0I10O ));END ELSE BEGIN OO10 := CPOS ('?', OI1OO1IIOl );IF OO10 > 0 THEN
  110. BEGIN FOR OIlO := OO10 TO LENGTH (OI1OO1IIOl ) DO IF (OI1OO1IIOl [ OIlO ] ='?')AND (OIlO <= LENGTH (O1010O1I0I10O ))THEN
  111. OI1OO1IIOl [ OIlO ] := O1010O1I0I10O [ OIlO ] END ;END ;END ;MATCHFILENAMES := OOO0OOI1ll10 + O1lO0I00IOlO + OI1OO1IIOl ;
  112. END ;FUNCTION XPARAMSTR (INDEX:WORD):STRING ;VAR OO1O:STRING ;BEGIN IF INDEX > PARAMCOUNT THEN XPARAMSTR := ''ELSE
  113. BEGIN OO1O := PARAMSTR (INDEX );IF LENGTH (OO1O )>= 1 THEN IF OO1O [ 1 ] ='/'THEN OO1O [ 1 ] := '-';IF OO1O ='-?'THEN
  114. OO1O := '-H';OO1O := UPSTR (OO1O );XPARAMSTR := OO1O ;END ;END ;PROCEDURE SETHANDLECOUNT (HANDLES:WORD);BEGIN IF LO
  115. (DOSVERSION )>= 5 THEN BEGIN DOSERROR := 0 ;ASM {} MOV AH , 67h {} MOV BX , HANDLES{} INT 21h {} JNC @end {}
  116. MOV DOSERROR, AX {} @end : {} END;CASE DOSERROR  OF 0 :;8 :SETHANDLECOUNTDOS3 (HANDLES );ELSE PRINTERROR
  117. ('SetHandleCount failed. DosError = '+ STRW (DOSERROR ), 0 );END ;END ELSE IF LO (DOSVERSION )>= 3 THEN
  118. SETHANDLECOUNTDOS3 (HANDLES );END ;PROCEDURE SETHANDLECOUNTDOS3 (HANDLES:WORD);CONST O1lIlOIl1I0I=255 ;
  119. TYPE OOIl01IlO0Ol=^OOIl01IlO0O0;OOIl01IlO0O0=ARRAY [ 1 .. O1lIlOIl1I0I]  OF BYTE;VAR OOlIll0O0lll:OOIl01IlO0Ol;
  120. OIlO:INTEGER;OO01:LONGINT;BEGIN IF (LO (DOSVERSION )< 3 )OR (HANDLES > O1lIlOIl1I0I )THEN EXIT ;{$IFDEF DPMI} OO01 :=
  121. GLOBALDOSALLOC (HANDLES );OOlIll0O0lll := PTR (LONGREC (OO01 ). LO , 0 );{$ELSE} GETMEM (OOlIll0O0lll , HANDLES );
  122. {$ENDIF} FILLCHAR (OOlIll0O0lll ^, HANDLES , $FF );FOR OIlO := 1 TO MEMW [ PREFIXSEG :$32 ]  DO OOlIll0O0lll ^[ OIlO ] :=
  123. MEM [ PREFIXSEG :$18 + OIlO - 1 ] ;MEMW [ PREFIXSEG :$32 ] := HANDLES ;{$IFDEF DPMI} MEML [ PREFIXSEG :$34 ] := LONGINT
  124. (PTR (LONGREC (OO01 ). HI , 0 ));{$ELSE} MEML [ PREFIXSEG :$34 ] := LONGINT (OOlIll0O0lll );{$ENDIF} END ;END .
  125.